perm filename TVIOF.F4[PIC,LCS]1 blob
sn#039048 filedate 1973-12-30 generic text, type T, neo UTF8
00100 C TVIOF NOVEMBER 9, 69 TVIOF
00200
00300 COMMON /EDGEC/ A0,A1,A2,A3,A4,A5,A6,A7,
00400 1 DEBUG,T,XP,YP,PARMAX,
00500 1 HALF,FILE,RR,COH,RX,RY,CL,SL,D,B,FOUND
00600
00700 COMMON /LISTC/ LIST,LIST5,NEWEND,LO
00800
00900 COMMON/COMMAC/BCLIP,TCLIP,BITS,IWID,LINLEN,FLINE,LLINE,
01000 1 LSIDE,RSIDE,DTA,HYSTAB
01100
01200 DIMENSION LIST5(0/1000),LIST(6,1000),BTLIP(0/15),
01300 1 XP(0/176),YP(0/176),T(0/1415),HYSTAB(0/15)
01400
01500 INTEGER BCLIP,TCLIP,BITS,FLINE,LLINE,
01600 1 LSIDE,RSIDE,HYSTAB,DTA,IB,HEL,I,TIM1,TIM2,TIM4,TIM5,
01700 1 TAPE,FILEN,NEWEND,ALFAB,YES,NO,FILE,BTLIP,LIP
01800
01900 REAL INT,HIG,QAL,QALOLD,NUPO,TIM3,HIL,HILOLD
02000
02100 LOGICAL LOAP,LOAU,PLAY,SAVU,SAVP,NOPR,NOLU,NOLP
02200 CC LOGICAL FUNCTION ADMISS
02300 CC ADMISS(DTA)=DTA.EQ.-7.OR.(1.LE.DTA.AND.DTA.LE.10)
02350 TAPE=1
02360 DTA=-7
02400 CALL TIMER(TIM1)
02500 1 CALL INITAL
02600 BCLIP=7
02700 TCLIP=0
02800 BITS=4
02900 FLINE=20
03000 LLINE=250
03100 LSIDE=6
03200 RSIDE=302
03300 C IWID=RSIDE-LSIDE+1
03400 C I=36/BITS
03500 C LINLEN=(IWID+I-1)/I
03600 C TVSZ=(LLINE-FLINE+1)*LINLEN
03700 YES='Y'
03800 NO ='N'
03900 SAVU=.FALSE.
04000 C UNPROCESSED PICTURE HAS BEEN SAVED IF SAVU.EQ..TRUE.
04100 SAVP=.FALSE.
04200 C PROCESSED PICTURE HAS BEEN SAVED
04300 LOAP=.FALSE.
04400 C PROCESSED PICTURE HAS BEEN LOADED
04500 LOAU=.FALSE.
04600 C UNPROCESSED PICTURE HAS BEEN LOADED
04700 PLAY=.FALSE.
04800 C PROGRAMS PICTURE WAS OFFERED OR OVER WRITTEN
04900 NOPR=.FALSE.
05000 C PROCESSING NOT WANTED
05100 NOLU=.FALSE.
05200 C LOADING OF UNPROCESSED NOT WANTED
05300 NOLP=.FALSE.
05400 C LOADING OF PROCESSED NOT WANTED
05500 3 FORMAT(' DO YOU WANT TO TAKE A PICTURE WITH THE TV CAMERA ?'/)
05600 TYPE 3
05700 6 ACCEPT 83,ALFAB
05800 IF(ALFAB.EQ.YES) GOTO 8
05900 IF(ALFAB.EQ.NO ) GOTO 158
06000 C TYPE 103
06100 GOTO 3
06200 8 DO 9 I=0,15
06300 9 BTLIP(I)=7-I/2
06400 7 FORMAT(' DO YOU WANT TO READ A FRAME
06500 1 OTHER THAN THE MAXIMAL ?'/)
06600 16 TYPE 7
06700 ACCEPT 83, ALFAB
06800 IF(ALFAB.EQ.YES) GOTO 18
06900 IF(ALFAB.EQ.NO ) GOTO 17
07000 CC TYPE 103
07100 GOTO 16
07200 18 TYPE 19
07300 19 FORMAT(' TYPE FLINE, LLINE, LSIDE, RSIDE'/)
07400 20 FORMAT(4I)
07500 ACCEPT 20,FLINE,LLINE,LSIDE,RSIDE
07600 21 FORMAT(4I4/)
07700 TYPE 21,FLINE,LLINE,LSIDE,RSIDE
07800 17 CALL TVIN
07900 CALL HISTO
08000 TYPE 63,BCLIP,TCLIP,(HYSTAB(I),I,BTLIP(I),I=0,15)
08100 10 FORMAT(' DO YOU WANT TO OVER WRITE AUTOMATIC CLIP
08200 1 LEVEL SETTING ?'/)
08300 30 TYPE 10
08400 11 ACCEPT 83,ALFAB
08500 IF(ALFAB.EQ.YES) GOTO 13
08600 IF(ALFAB.EQ. NO) GOTO 62
08700 CC TYPE 103
08800 GOTO 11
08900 12 FORMAT(' TYPE BCLIP'/)
09000 13 TYPE 12
09100 ACCEPT 133,BCLIP
09200 15 FORMAT(1H+,I1/)
09300 TYPE 15,BCLIP
09400 14 FORMAT(' TYPE TCLIP'/)
09500 TYPE 14
09600 ACCEPT 133,TCLIP
09700 TYPE 15, TCLIP
09800 GOTO 67
09900 62 CALL CLIPS
10000 63 FORMAT(7H BCLIP=I2/7H TCLIP=I2//16(I7,2I4/))
10100 66 FORMAT(' RETURN CARRIAGE FOR FINAL TV READING',$)
10200 67 TYPE 66
10300 ACCEPT 83,ALFAB
10400 DO 64 I=0,15
10500 HILOLD=HIL
10600 HIL=(1.0-(FLOAT(I)-0.5)/14.0)*(BCLIP-TCLIP)+TCLIP
10700 BTLIP(I)=-0
10800 IF(I.EQ.0) GOTO 64
10900 LIP=IFIX(HILOLD)
11000 IF(IFIX(HIL).EQ.LIP) GOTO 64
11100 BTLIP(I-1)=LIP
11200 BTLIP(I) = LIP
11300 64 CONTINUE
11400 CALL TVIN
11500 CALL HISTO
11600 TYPE 63,BCLIP,TCLIP,(HYSTAB(I),I,BTLIP(I),I=0,15)
11700 68 FORMAT(' IS THIS ACCEPTABLE ?'/)
11800 69 TYPE 68
11900 ACCEPT 83,ALFAB
12000 IF(ALFAB.EQ.YES) GOTO 71
12100 IF(ALFAB.EQ.NO ) GOTO 30
12200 CC TYPE 103
12300 GOTO 69
12400 71 LOAU=.TRUE.
12500 75 IF(SAVU) GOTO 152
12600 73 FORMAT(' DO YOU WANT TO SAVE THE UNPROCESSED IMAGE ?'/)
12700 TYPE 73
12800 83 FORMAT(A5)
12900 93 ACCEPT 83,ALFAB
13000 IF(ALFAB.EQ.YES) GOTO 173
13010 CC IF(ALFAB.EQ.YES) GOTO 123
13100 IF(ALFAB.EQ.NO ) GOTO 151
13200 CC103 FORMAT(33H PLEASE ANSWER ONLY 'YES' OR 'NO'/)
13300 CC TYPE 103
13400 GOTO 73
13500 CC113 FORMAT(' TYPE NUMBER OF OUTPUT DRIVE'/)
13600 CC123 TYPE 113
13700 133 FORMAT(I)
13800 CC ACCEPT 133,DTA
13900 CC183 FORMAT(1H+,I2/)
14000 CC TYPE 183,DTA
14100 CC IF(ADMISS(DTA)) GOTO 173
14200 CC184 FORMAT(' THIS NUMBER IS NOT PERMISSIBLE'/' FOR DSK TAKE DRIVE -7'/
14300 CC 1' FOR MTA0 TAKE DRIVE 8'/' FOR MTA1 TAKE DRIVE 9'/)
14400 CC TYPE 184
14500 CC GOTO 123
14600 193 FORMAT(' GIVE THE FILE A NAME'/)
14700 173 TYPE 193
14800 ACCEPT 83,FILE
14900 CC TYPE 253,FILE
15000 CALL DECDMP
15100 SAVU=.TRUE.
15200 GOTO 158
15300 151 SAVU=.TRUE.
15400 152 IF(NOPR) GOTO 340
15500 188 FORMAT(' DO YOU WANT TO PROCESS THE IMAGE ?'/)
15600 TYPE 188
15700 198 ACCEPT 83,ALFAB
15800 IF(ALFAB.EQ.YES) GOTO 203
15900 IF(ALFAB.EQ.NO ) GOTO 307
16000 CC TYPE 103
16100 GOTO 188
16200 158 IF(NOLU) GOTO 308
16300 156 FORMAT(' DO YOU WANT TO LOAD AN UNPROCESSED IMAGE ?'/)
16400 TYPE 156
16500 160 ACCEPT 83,ALFAB
16600 IF(ALFAB.EQ.YES) GOTO 205
16610 CC IF(ALFAB.EQ.YES) GOTO 165
16700 IF(ALFAB.EQ.NO ) GOTO 304
16800 CC TYPE 103
16900 GOTO 156
17000 CC164 FORMAT(' TYPE NUMBER OF INPUT DRIVE'/)
17100 CC165 TYPE 164
17200 CC174 ACCEPT 133,DTA
17300 CC TYPE 183,DTA
17400 CC IF(ADMISS(DTA)) GOTO 205
17500 CC TYPE 165
17600 CC GOTO 174
17700 204 FORMAT(' TYPE THE FILE NAME'/)
17800 205 TYPE 204
17900 ACCEPT 83,FILE
18000 CC TYPE 253,FILE
18100 CALL DECINP
18200 LOAU=.TRUE.
18300 SAVU=.FALSE.
18400 NOPR=.FALSE.
18500 GOTO 75
18600 203 CALL SCAHEX
18700 SAVP=.FALSE.
18800 NOLU=.FALSE.
18900 PLAY=.TRUE.
19000 202 FORMAT(' NEWEND=',I4/)
19100 TYPE 202,NEWEND
19200 199 LOAP=.TRUE.
19300 209 CONTINUE
19400 210 IF(.NOT.LOAP) GOTO 1
19500 218 CONTINUE
19600 219 IF(SAVP) GOTO 235
19700 IF(.NOT.LOAP) GOTO 1
19800 213 FORMAT(' DO YOU WANT TO SAVE THE PROCESSED IMAGE ?'/)
19900 TYPE 213
20000 223 ACCEPT 83,ALFAB
20100 IF(ALFAB.EQ.YES) GOTO 243
20200 IF(ALFAB.EQ.NO ) GOTO 235
20300 CC TYPE 103
20400 GOTO 213
20500 CC233 TYPE 113
20600 CC ACCEPT 133,DTA
20700 CC TYPE 183,DTA
20800 CC IF(ADMISS(DTA)) GOTO 243
20900 CC TYPE 184
21000 CC GOTO 233
21100 243 TYPE 193
21200 ACCEPT 83,FILE
21300 253 FORMAT(1H+,A5/)
21400 CC TYPE 253,FILE
21500 CC TAPE=8+DTA
21600 FILEN=6*(NEWEND+1)
21700 CALL ZERPP
21800 CALL OFILE(TAPE,FILE)
21900 WRITE(TAPE) FILEN,RR,FLINE,LLINE,LSIDE,RSIDE,NEWEND,
22000 1 ((LIST(I,N),I=1,6),N=1,NEWEND)
22100 END FILE TAPE
22200 SAVP=.TRUE.
22300 NOLP=.FALSE.
22400 IF(LOAU) GOTO 75
22500 235 IF(.NOT.LOAP) GOTO 1
22600 CC230 FORMAT(' DO YOU WANT TO PLOT THE IMAGE ?'/)
22700 CC TYPE 230
22800 CC240 ACCEPT 83,ALFAB
22900 CC IF(ALFAB.EQ.YES) GOTO 250
23000 CC IF(ALFAB.EQ.NO ) GOTO 260
23100 CCCC TYPE 103
23200 CC GOTO 240
23300 CC250 CONTINUE
23400 252 CALL PLOU
23500 SHOW=.TRUE.
23600 LOAP=.FALSE.
23700 NOPR=.FALSE.
23800 PLAY=.TRUE.
23900 SAVP=.TRUE.
24000 NOLP=.FALSE.
24100 GOTO 260
24200 304 NOLU=.TRUE.
24300 305 IF(LOAU) GOTO 152
24400 300 FORMAT(' DO YOU WANT TO LOAD A PROCESSED IMAGE ?'/)
24500 GOTO 306
24600 307 NOPR=.TRUE.
24700 306 IF(PLAY) GOTO 235
24800 308 IF(NOLP) GOTO 260
24900 TYPE 300
25000 310 ACCEPT 83,ALFAB
25100 IF(ALFAB.EQ.YES) GOTO 320
25200 IF(ALFAB.EQ.NO ) GOTO 338
25300 CC TYPE 103
25400 GOTO 308
25500 320 NAME=.TRUE.
25600 CC TYPE 164
25700 CC ACCEPT 133,DTA
25800 CC TYPE 183,DTA
25900 CC IF(ADMISS(DTA)) GOTO 330
26000 CC TYPE 184
26100 CC GOTO 320
26200 330 TYPE 204
26300 ACCEPT 83,FILE
26400 CC TYPE 253,FILE
26500 DO 335 I=1,6000
26600 335 LIST(I,1)=0.
26700 CC TAPE=8+DTA
26800 CC CALL ZERPP
26850 REWIND TAPE
26900 CALL IFILE(TAPE,FILE)
27000 READ(TAPE) FILEN,RR,FLINE,LLINE,LSIDE,RSIDE,NEWEND,
27100 1 ((LIST(I,N),I=1,6),N=1,NEWEND)
27200 TYPE 202,NEWEND
27300 SHOW=.FALSE.
27400 LOAP=.TRUE.
27500 PLAY=.TRUE.
27600 NOLP=.FALSE.
27800 SAVP=.FALSE.
27900 GOTO 199
27950 338 IF(NOLP.AND.LOAU.AND.SAVU.AND.NOPR) GOTO 261
28000 NOLP=.TRUE.
28100 340 IF(.NOT.LOAP) GOTO 260
28200 IF(PLAY) GOTO 260
28300 339 FORMAT(' AN IMAGE WAS LOADED WITH THE PROGRAM'//)
28400 TYPE 339
28500 PLAY=.TRUE.
28600 LOAP=.TRUE.
28700 GOTO 210
28710 341 IF(NOLP) GOTO 261
28720 GOTO 308
28800 260 IF(SAVU.AND.NOPR.AND.(.NOT.LOAP).AND.LOAU) GOTO 341
28900 IF(LOAU) GOTO 75
29000 261 CALL TIMER(TIM2)
29100 TIM3=FLOAT(TIM2-TIM1)/60000.
29200 163 FORMAT(' THIS RUN CONSUMED ',F5.3,' MINUTES OF COMPUTING TIME'/)
29300 TYPE 163,TIM3
29400 END